home *** CD-ROM | disk | FTP | other *** search
10 REM **************************************************************************************************************** 20 REM 'PAMBOOKS' - A SIMPLE BOOKKEEPING SYSTEM TO USE WITH 'PAMCHECK' PROGRAM 30 REM **************************************************************************************************************** 40 ' 50 ' PAM - PERSONAL ACCOUNTS MANAGER Version 1.0 60 ' COPYRIGHT 1983 70 ' S. E. BUTTON 80 ' 90 ' WARNING 100 ' This software (and manual) are both protected by U. S. Copyright Law (Title 17 United States Code). 110 ' Unauthorized reproduction and/or sales may result in imprisonment of up to 1 year and fines of up to $10,000 (17 USC 506). 120 ' Copyright infringers may be subject to civil liability. 130 ' 140 ' 150 SCREEN 0,0,0: DEF SEG = &H40: IF (PEEK(&H10) AND &H30) = &H30 THEN WIDTH 80: IN$ = SPACE$(20) ELSE WIDTH 40: IN$ = "" 160 DEF SEG: POKE 106,0: DEFINT I-K: KEY OFF: FOR I = 1 TO 10: KEY I,"": NEXT I 'SET FUNCTION KEYS TO NULL 170 WIDTH "LPT1:",132: ON ERROR GOTO 1750 180 PRINT: PRINT IN$;" Does your printer require condensed" 190 PRINT IN$;" character printing mode to print 132" 200 PRINT IN$;" characters per line? Reply Y or N" 210 C$ = INKEY$: IF C$ = "" THEN 210 220 IF C$ = "N" OR C$ = "n" THEN PMODE$ = CHR$(18): GOTO 260 230 IF C$ = "Y" OR C$ = "y" THEN PMODE$ = CHR$(15): GOTO 250 240 PRINT IN$;" I need a Y or N. Retry": GOTO 210 250 LPRINT CHR$(15); 'TURN ON CONDENSED CHARACTER PRINT MODE 260 GOTO 420 '1ST LINE OF PROGRAM 270 REM -----------------------------------INDEX OF SUBROUTINE ENTRY POINTS --------------------------------------------- 280 GOTO 650 'DISPLAY BOOKKEEPING SYSTEM JOBS MENU 290 GOSUB 1370: RETURN 'OPEN ACCOUNTS.REC FILE 300 GOSUB 1460: RETURN 'OPEN AUDTRAIL.REC FILE 310 GOSUB 1520: RETURN 'GET REQUESTED ACCOUNTS FILE RECORD 320 GOSUB 1570: RETURN 'PUT REQUESTED ACCOUNTS FILE RECORD 330 GOSUB 1620: RETURN 'UPDATE ACCOUNTS FILE CONTROL RECORD 340 GOSUB 1700: RETURN 'READ RECORD FROM AUDTRAIL.REC FILE 350 GOSUB 1860: RETURN 'PRINT ACCOUNTS FILE RECORD 360 GOSUB 2170: RETURN 'PRINT ACCOUNTS REPORT HEADING 370 GOSUB 2310: RETURN 'DATA ENTRY VALIDATION ROUTINE 380 GOTO 2700 'PROGRAM END 390 REM ***************************************************************************************************************** 400 REM VARIABLES WHICH MAY BE CHANGED TO MEET USER REQUIREMENTS - SEE APPENDIX D OF USER'S MANUAL 410 REM **************************************************************************************************************** 420 M10% = 384 'NUMBER OF PRIME AREA RECORDS IN ACCOUNTS FILE 430 M11% = 32 'NUMBER OF OVERFLOW AREA RECORDS IN ACCOUNTS FILE 440 DIM STOCK$(M11%), QUOTE#(M11%) 'STOCK MARKET CORP. CODE AND MARKET QUOTATION ARRAYS 450 ' 460 ' 470 REM ---------------------------------------------------------------------------------------------------------------- 480 REM LITERALS AND CONSTANTS 490 REM --------------------------------------------------------------------------------------------------------------- 500 NOTNUM$ = " Not a valid numeric entry, retry." 510 TITLE$ = SPACE$(15) 520 ACTION$ = SPACE$(18) 530 ENTER$ = CHR$(13) 'ENTER KEY 540 BKSPC$ = CHR$(8) 'BACKSPACE KEY 550 ESC$ = CHR$(27) 'ESCAPE KEY 560 Y = 1: X = 1 'CURSOR SAVE FIELDS FOR LINE & ROW 570 TRUE% = -1: FALSE% = 0 'TRUE/FALSE VALUES 580 FIELDMAX% = 0 'MAXIMUM DATA ENTRY FIELD LENGTH 590 DATA.CNT% = 0 'DATA ENTRY CHARACTER COUNT 600 DATU$ = "" 'DATA ENTRY FIELD 610 CK$ = "" 'DATA ENTRY INKEY$ CHARACTER FIELD 620 REM *************************************************************************************************************** 630 REM DISPLAY THE BOOKKEEPING SYSTEM JOB MENU 640 REM *************************************************************************************************************** 650 CLS 660 PRINT: PRINT IN$;" BOOKKEEPING JOB CHOICES MENU": PRINT 670 PRINT IN$;" F1 Accounts File, Create & Maintain" 680 PRINT IN$;" F2 Journal Entry, Post to Accounts" 690 PRINT IN$;" F3 Depreciation of Assets" 700 PRINT IN$;" F4 Net Worth Statement" 710 PRINT IN$;" F5 Accounts File Close, Period-End" 720 PRINT IN$;" Income and Expenses Statement" 730 PRINT IN$;" F6 Trial Balance Report" 740 PRINT IN$;" F7 Accounts File - Print Contents" 750 PRINT IN$;" F8 Job is completed. Stop this run" 760 PRINT IN$;" F9 Transfer to PAMCHECK Job Choices" 770 PRINT: BEEP: PRINT IN$;: COLOR 0,7: PRINT " Press Function Key for Job Choice. ";: Y = CSRLIN: X = POS(0) 780 CK$ = INKEY$: IF CK$ = "" THEN 780 790 CK = ASC(CK$): IF CK = 0 THEN GOTO 810 800 BEEP: BEEP: GOTO 770 'NOT A FUNCTION KEY WHEN CK<>0 810 FKEY = ASC(RIGHT$(CK$,1)) 'TEST 2ND BYTE FOR WHICH FUNCTION KEY PRESSED 820 IF FKEY > 58 AND FKEY < 69 THEN CHOICE = FKEY - 58: GOTO 840 830 GOTO 770 840 PRINT CHOICE: COLOR 7,0 850 IF (CHOICE>0) AND (CHOICE<10) THEN GOTO 880 860 BEEP: BEEP: COLOR 31,0: PRINT IN$;" Choices are 1 thru 9, try again"; 870 GOTO 780 880 ON CHOICE GOTO 930,970,1010,1050,1130,1090,1170,2700,1240 890 GOTO 650 900 REM *************************************************************************************************************** 910 REM CHAIN MERGE PROGRAM OVERLAYS 920 REM *************************************************************************************************************** 930 CLS 940 LOCATE 12,3 950 PRINT IN$;"Loading Program BOOKMAIN Into Memory" 960 CHAIN MERGE "B:BOOKMAIN.BAS",4000,ALL,DELETE 4000-9000 970 CLS 980 LOCATE 12,3 990 PRINT IN$;"Loading Program BOOKPOST Into Memory" 1000 CHAIN MERGE "B:BOOKPOST.BAS",4000,ALL,DELETE 4000-9000 1010 CLS 1020 LOCATE 12,3 1030 PRINT IN$;"Loading Program BOOKDEPR Into Memory" 1040 CHAIN MERGE "B:BOOKDEPR.BAS",4000,ALL,DELETE 4000-9000 1050 CLS 1060 LOCATE 12,3 1070 PRINT IN$;"Loading Program BOOKWRTH Into Memory" 1080 CHAIN MERGE "B:BOOKWRTH.BAS",4000,ALL,DELETE 4000-9000 1090 CLS 1100 LOCATE 12,3 1110 PRINT IN$;"Loading Program BOOKTBAL Into Memory" 1120 CHAIN MERGE "B:BOOKTBAL.BAS",4000,ALL,DELETE 4000-9000 1130 CLS 1140 LOCATE 12,3 1150 PRINT IN$;"Loading Program BOOKCLSE Into Memory" 1160 CHAIN MERGE "B:BOOKCLSE.BAS",4000,ALL,DELETE 4000-9000 1170 CLS 1180 LOCATE 12,3 1190 PRINT IN$;"Loading Program BOOKPRNT Into Memory" 1200 CHAIN MERGE "B:BOOKPRNT.BAS",4000,ALL,DELETE 4000-9000 1210 REM *************************************************************************************************************** 1220 REM LOAD 'PAMCHECK' PROGRAM AND CHOOSE FROM 'JOB CHOICES MENU' 1230 REM *************************************************************************************************************** 1240 CLOSE 'CLOSE BOOKKEEPING FILES 1250 CLS 1260 LOCATE 12,1 1270 PRINT IN$;: COLOR 0,7: PRINT " Insert PAMCHECK Diskette in Drive A": COLOR 7,0 1280 PRINT IN$;: COLOR 0,7: PRINT " Press any key to continue ": COLOR 7,0 1290 IF INKEY$ = "" THEN GOTO 1290 1300 PRINT: PRINT IN$;" Loading Program PAMCHECK Into Memory" 1310 LOAD"A:PAMCHECK",R 1320 REM *************************************************************************************************************** 1330 REM SUBROUTINES 1340 REM *************************************************************************************************************** 1350 REM SUBROUTINE TO OPEN BOOKKEEPING SYSTEM ACCOUNTS FILE 1360 REM *************************************************************************************************************** 1370 CLOSE 'BE SURE FILES ARE NOT OPEN FROM PREVIOUS PROCESSING 1380 OPEN "B:ACCOUNTS.REC" AS #1 LEN=128 1390 ON ERROR GOTO 1750 1400 REM --------------------------------------------------------------------------------------------------------------- 1410 REM BOOKKEEPING SYSTEM 'ACCOUNTS' FILE #1 FIELDS IN THE I/O BUFFER 1420 REM --------------------------------------------------------------------------------------------------------------- 1430 FIELD #1,2 AS B1$,2 AS B2$,1 AS F4$,4 AS B3$,2 AS B4$,30 AS B5$,30 AS B6$,4 AS B7$,8 AS B8$,8 AS B9$,2 AS B10$,1 AS B11$,8 AS B12$,8 AS B13$,8 AS B14$,8 AS B15$,2 AS B16$ 1440 RETURN 1450 REM *************************************************************************************************************** 1460 OPEN "B:AUDTRAIL.REC" FOR INPUT AS #3 1470 ON ERROR GOTO 1750 1480 RETURN 1490 REM *************************************************************************************************************** 1500 REM SUBROUTINE TO GET THE REQUESTED 'ACCOUNTS' FILE #1 RECORD 1510 REM ************************************************************************************************************** 1520 GET #1,REC% 1530 RETURN 1540 REM ************************************************************************************************************** 1550 REM SUBROUTINE TO PUT THE REQUESTED 'ACCOUNTS' FILE #1 RECORD 1560 REM ************************************************************************************************************** 1570 PUT #1,REC% 1580 RETURN 1590 REM ************************************************************************************************************** 1600 REM SUBROUTINE TO UPDATE THE ACCOUNTS FILE CONTROL RECORD - FIRST RECORD IN FILE 1610 REM ************************************************************************************************************** 1620 GET #1,1 1630 LSET B5$ = "LAST UPDATED ON " + DATE$ 1640 LSET B6$ = "TIME OF UPDATE " + TIME$ 1650 PUT #1,1 1660 RETURN 1670 REM ************************************************************************************************************** 1680 REM SUBROUTINE TO READ RECORD FROM 'AUDTRAIL' FILE #3 1690 REM ************************************************************************************************************** 1700 INPUT #3,DA$,TI$,TC$,CN%,AC$,TD$,PA%,PC$,PA$,TAMT,LACTM%,LACTS%,LAMT,BDIW,BAMT 1710 RETURN 1720 REM ************************************************************************************************************** 1730 REM ERROR HANDLING SUBROUTINE 1740 REM ************************************************************************************************************** 1750 IF ERR=27 THEN COLOR 31,0: PRINT IN$;" Printer is not ON": PRINT IN$;" or is out of paper": BEEP: BEEP: COLOR 7,0: RESUME 1760 IF ERR=24 THEN COLOR 31,0: PRINT IN$;" Printer not READY!!!": BEEP: BEEP: COLOR 7,0: RESUME 1770 IF ERR=25 THEN COLOR 31,0: PRINT IN$;" Check PRINTER and DISK are READY!!!": BEEP: BEEP: COLOR 7,0: RESUME 1780 ERM1$ = " Field allocation is" 1790 ERM2$ = " greater than record length." 1800 ERM3$ = " Correct program, then restart" 1810 IF ERR=50 AND ERL=1430 THEN COLOR 31,0: PRINT IN$;" FILE #4";ERM1$: PRINT IN$;ERM2$: PRINT IN$;ERM3$: COLOR 7,0: END 1820 ON ERROR GOTO 0 1830 REM ************************************************************************************************************** 1840 REM SUBROUTINE TO PRINT AN ACCOUNTS FILE RECORD 1850 REM ************************************************************************************************************** 1860 IF LINECT% > 58 THEN GOSUB 2170 'PRINT REPORT HEADING LINES 1870 LACTM% = CVI(B1$) 1880 LACTS% = CVI(B2$) 1890 LPRINT USING "####";LACTM%;LACTS%; 1900 LPRINT " ";B3$; 1910 KINT% = CVI(B4$) 1920 IF KINT%<>0 THEN LPRINT USING "####";KINT%; ELSE LPRINT SPC(4); 1930 LPRINT " ";B5$; 1940 KSP! = CVS(B7$) 1950 IF ABS(KSP!) > .0001 THEN LPRINT USING " ####.### ";KSP!; ELSE LPRINT SPC(10); 1960 LPRINT B8$; 1970 KDP# = CVD(B9$) 1980 IF ABS(KDP#) > .001 THEN LPRINT USING "######,.## ";KDP#; ELSE LPRINT SPC(12); 1990 KINT% = CVI(B10$) 2000 IF KINT%<>0 THEN LPRINT USING "### ";KINT%; ELSE LPRINT SPC(5); 2010 LPRINT B11$; 2020 KDP# = CVD(B12$) 2030 IF ABS(KDP#) > .001 THEN LPRINT USING " ######,.##-";KDP#; ELSE LPRINT SPC(12); 2040 KDP# = CVD(B13$) 2050 IF ABS(KDP#) > .001 THEN LPRINT USING " ######,.##-";KDP#; ELSE LPRINT SPC(12); 2060 KDP# = CVD(B14$) 2070 IF ABS(KDP#) > .001 THEN LPRINT USING " ######,.##-";KDP#; ELSE LPRINT SPC(12); 2080 KDP# = CVD(B15$) 2090 IF ABS(KDP#) > .001 THEN LPRINT USING "######,.##-";KDP# ELSE LPRINT SPC(11) 2100 LPRINT ACTION$;B6$ 2110 LPRINT 2120 LINECT% = LINECT% + 3 2130 RETURN 2140 REM ************************************************************************************************************** 2150 REM SUBROUTINE TO PRINT ACCOUNTS REPORT HEADING 2160 REM ************************************************************************************************************** 2170 IF PAGENO% <> 0 THEN LPRINT CHR$(12) 2180 PAGENO% = PAGENO% + 1 2190 LPRINT PMODE$;DATE$; TAB(31);"BOOKKEEPING SYSTEM - ACCOUNTS FILE - AUDIT LISTING ";TITLE$;TAB(122);"PAGE"; 2200 LPRINT USING " ####";PAGENO% 2210 LPRINT: LPRINT TAB(59);"ASSET-ACQUIRED OR ASSET ASSET";TAB(118);"INCOME/EXPENSE" 2220 LPRINT "ACCT REC PAYEE";TAB(59);"LIABILITY-INCURRED MOS. DPR CUMULATIVE";TAB(121);"BUDGET OR" 2230 LPRINT " # # NO. REC D E S C R I P T I O N UNITS DATE AMOUNT LIFE CDE DEPREC'TN DEBIT CREDIT ASSET SALVAGE" 2240 LPRINT 2250 LINECT% = 6 2260 RETURN 2270 REM ************************************************************************************************************** 2280 REM SUBROUTINE TO VALIDATE DATA ENTRY 2290 REM ************************************************************************************************************** 2300 SOUND 50,4 'TONE TO SIGNAL REENTER DATA 2310 LOCATE Y,X: COLOR 0,7 2320 DEF SEG = &H40 2330 POKE &H17,(PEEK(&H17) OR &H60) 'TURN NUM LOCK AND CAPS LOCK ON 2340 DEF SEG 2350 POKE 106,0 2360 PRINT "[";STRING$(FIELDMAX%,"-");"]"; 2370 DATU$ = "" 'SET DATA ENTRY FIELD TO NULL 2380 DATA.CNT% = 0 'SET DATA ENTRY COUNT FIELD TO ZERO 2390 LOCATE Y,X+1 'SET CURSOR TO FIRST PRINT POSITION 2400 IF INKEY$ <> "" THEN GOTO 2400 'CLEAR KEYSTROKE BUFFER 2410 CK$ = INKEY$: IF CK$ = "" THEN GOTO 2410 2420 IF CK$ = ENTER$ THEN GOTO 2550 2430 IF CK$ = BKSPC$ THEN GOSUB 2600: GOTO 2400 'ERASE LAST CHARACTER ENTERED 2440 IF CK$ = ESC$ THEN GOTO 2300 'REENTER ALL DATA 2450 CK = ASC(CK$): IF CK = 0 THEN BEEP: BEEP: GOTO 2400 'DISALLOW SPECIAL KEYS 2460 IF NOT NUM.ONLY% THEN GOTO 2510 'ALPHAMERIC FIELD IF NOT TRUE 2470 IF CK >= ASC("0") AND CK <= ASC("9") THEN GOTO 2510 'VALID NUMERIC 2480 IF NOT DEC.MINUS% THEN GOTO 2500 2490 IF CK$ = "." OR CK$ = "-" THEN GOTO 2510 'NUMERIC FIELD MAY HAVE DECIMAL OR MINUS 2500 SOUND 50,4: GOTO 2400 'INVALID KEY ENTRY 2510 DATA.CNT% = DATA.CNT% + 1 'INCREMENT DATA COUNT 2520 DATU$ = DATU$ + CK$: PRINT CK$;: 'APPEND ENTRY TO DATA FIELD AND PRINT 2530 IF DATA.CNT% >= FIELDMAX% THEN GOTO 2550 2540 GOTO 2400 'INPUT NEXT CHARACTER 2550 COLOR 7,0 2560 RETURN 'DATA ENTRY FIELD COMPLETED 2570 REM -------------------------------------------------------------------------------------------------------------- 2580 REM SUBROUTINE TO BACKSPACE AND ERASE DATA ENTRY CHARACTER 2590 REM -------------------------------------------------------------------------------------------------------------- 2600 IF DATA.CNT% = 0 THEN RETURN 'TEST IF BACKSPACE KEY IS FIRST DATA ENTRY KEY 2610 DATU$ = LEFT$(DATU$,DATA.CNT% - 1) 'DROP LAST KEYED ENTRY 2620 LOCATE Y,(X + DATA.CNT%) 'SET CURSOR TO ERASE POSITION 2630 PRINT CHR$(45); 'OVERLAY WITH DASH CHARACTER 2640 LOCATE Y,(X + DATA.CNT%) 'SET CURSOR FOR POSITION JUST ERASED 2650 DATA.CNT% = DATA.CNT% - 1 'DECREMENT COUNT 2660 RETURN 2670 REM ************************************************************************************************************** 2680 REM PROGRAM END 2690 REM ************************************************************************************************************** 2700 LPRINT CHR$(18) 2710 IF FKEY <> 66 THEN COLOR 31,0: PRINT IN$;" PAMBOOKS program cancelled": COLOR 7,0: CLOSE: END 2720 CLS 2730 LOCATE 12,1 2740 PRINT IN$;" PAMBOOKS program normal End-of-Job" 2750 CLOSE: END 2760 REM -------------------------------------------------------------------------------------------------------------- 4000 GOTO 4000 'CHAIN MERGE AREA 9000 GOTO 9000 'CHAIN MERGE AREA 9010 GOTO 9010 'STATEMENT FOLLOWING CHAIN MERGE AREA 4000 GOTO 4000 'CHAIN MERGE AREA 9000 GOTO 9000 'CHAIN MERGE AREA 9010 GOTO 9010 'STATEMENT FOLLOWING CHAIN MERGE AREA 
